home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 72 / applic / pm2ts.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-21  |  29.7 KB  |  924 lines
  1. PROGRAM Print_Master_to_TypeSetter;
  2.  
  3.      {                  PM2TS -  a graphics utility               }
  4.      {                          by                                }
  5.      {                   David W Binnion                          }
  6.      {         Delphi - D_W_B    CompuServe - 76515, 1571         }
  7.      {                                                            }
  8.      { converts Print Master (tm) icons to Type Setter (tm) icons }
  9.      { in monochrome format.                                      }
  10.      {                         07-29-86                           }
  11.      {                                                            }
  12.      {   Portions of this product are Copyright (c) 1986, by OSS  }
  13.      {         and CCD.  Used by permission of OSS.               }
  14.      {                                                            }
  15.      {    I'd like to run this is medium res too but I don't      }
  16.      {    have access to a color monitor.  Out in the sticks      }
  17.      {    where I live IBM is God and Atari a pimple on his       }
  18.      {    CPU.  Feel free to modify this to your liking and       }
  19.      {    leave a message if you upgrade it to color.  I'd        }
  20.      {    be pleased to see it.                                   }
  21.  
  22.   CONST
  23.  
  24.     {$I GEMCONST.PAS}
  25.  
  26.   TYPE
  27.  
  28.       str88 = STRING[88];
  29.       str16 = STRING[16];
  30.       chr16 = PACKED ARRAY [1..16] OF CHAR;
  31.       chr2 = PACKED ARRAY [ 1..2 ] OF CHAR;
  32.       path_chars = PACKED ARRAY [1..80] OF CHAR;
  33.  
  34.     {$I gemtype.pas}
  35.  
  36.   VAR window_number : INTEGER;
  37.  
  38.     {$I gemsubs}
  39.  
  40.  
  41. PROCEDURE good_bye;
  42.  
  43. VAR message : STRING;
  44.     choice : INTEGER;
  45.  
  46. BEGIN
  47.      message :=                '[0][Thanks for using ';
  48.      message := CONCAT( message , '|     PM2TS' );
  49.      message := CONCAT( message , '|---------------- ' );
  50.      message := CONCAT( message , '|     D_W_B]' );
  51.      message := CONCAT( message , '[ goodbye! ]' );
  52.      choice := Do_Alert( message, 1 );
  53.  
  54. END; { vanity1 }
  55.  
  56.  
  57. PROCEDURE Vanity1;
  58.  
  59. VAR message : STRING;
  60.     choice : INTEGER;
  61.  
  62. BEGIN
  63.      message :=                '[0][     PM2TS (c)...by';
  64.      message := CONCAT( message , '|     D_W_B - Delphi' );
  65.      message := CONCAT( message , '| 76515,1571 - CompuServe|]' );
  66.      message := CONCAT( message , '[ go ]' );
  67.      choice := Do_Alert( message, 1 );
  68.  
  69. END; { vanity1 }
  70.  
  71.  
  72. PROCEDURE Vanity2;
  73.  
  74. VAR message : STRING;
  75.     choice : INTEGER;
  76.  
  77. BEGIN
  78.      message :=                '[3][| Portions of this ';
  79.      message := CONCAT( message , '|   product are ');
  80.      message := CONCAT( message , '|  Copyright (c), ]');
  81.      message := CONCAT( message , '[ 1986 ]' );
  82.      choice := Do_Alert( message, 1 );
  83.  
  84. END; { vanity2 }
  85.  
  86.  
  87. PROCEDURE Vanity3;
  88.  
  89. VAR message : STRING;
  90.     choice : INTEGER;
  91.  
  92. BEGIN
  93.      message :=                '[1][| by OSS and CCD. Used ';
  94.      message := CONCAT( message , '|  by permission of OSS. ]');
  95.      message := CONCAT( message , '[ okay! ]' );
  96.      choice := Do_Alert( message, 1 );
  97.  
  98. END; { vanity3 }
  99.  
  100.  
  101. PROCEDURE Vanity;
  102.  
  103. BEGIN
  104.         vanity1;
  105.         vanity2;
  106.         vanity3;
  107. END;
  108.  
  109.  
  110. PROCEDURE Clean_Window;
  111.  
  112. VAR x, y, h, w : INTEGER;
  113.  
  114. BEGIN
  115.      Hide_Mouse;
  116.      Work_Rect( window_number, x, y, h, w );
  117.      Set_Clip( x, y, h, w);
  118.      Paint_Color( white );
  119.      Paint_Style( 1 );
  120.      Paint_Rect( x, y, h, w );
  121.      Paint_Color( black );
  122.      Show_Mouse;
  123.  
  124. END; { Clean_Window }
  125.  
  126.  
  127. PROCEDURE Screen_Set_Up( VAR window_number : INTEGER);
  128.  
  129. VAR x, y, h, w : INTEGER;
  130.     title : Window_Title;
  131.     info : path_name;
  132.  
  133. BEGIN
  134.      title := ' Print Master to TypeSetter ';
  135.      window_number := New_Window( G_name | G_Info , title, 0,0,0,0);
  136.      Hide_Mouse;
  137.      info := ' ';
  138.      Set_WInfo( window_number , info );
  139.      Open_Window( window_number, 0,0,0,0);
  140.      Work_Rect( window_number, x, y, h, w );
  141.      Set_Clip( x, y, h, w );
  142.      Clean_Window;
  143.      Text_color( black );
  144.      Line_Color( black );
  145.      Draw_Mode( 1 );
  146.      Line_Style( 1 );
  147.      Show_Mouse;
  148.  
  149. END; { screen_set_up }
  150.  
  151.  
  152. FUNCTION f_write( handle : INTEGER; count : LONG_INTEGER;
  153.                   VAR buf : chr2 ) : LONG_INTEGER;
  154. GEMDOS( $40 );
  155.  
  156.  
  157. FUNCTION f_create( VAR f_name : path_chars;
  158.                    attributes : INTEGER) : INTEGER;
  159. GEMDOS( $3c );
  160.  
  161.  
  162. FUNCTION f_open( VAR o_name : path_chars; mode : INTEGER ) : INTEGER;
  163. GEMDOS( $3d );
  164.  
  165.  
  166. FUNCTION f_read( handle : INTEGER; count : LONG_INTEGER;
  167.                  VAR buf : chr16 ) : LONG_INTEGER;
  168. GEMDOS( $3f);
  169.  
  170.  
  171. FUNCTION f_seek( offset : LONG_INTEGER; handle, mode : INTEGER )
  172.           : LONG_INTEGER;
  173. GEMDOS( $42 );
  174.  
  175. FUNCTION f_close( handle : INTEGER ) : INTEGER;
  176. GEMDOS( $3e);
  177.  
  178.  
  179. PROCEDURE Make_Pathname( VAR pn : path_chars; fn : path_name );
  180.  
  181. VAR i : INTEGER;
  182.  
  183. BEGIN
  184.  
  185.      FOR i := 1 to length( fn ) DO       { pathname must be held }
  186.           pn[ i ] := fn[ i ];            { in character array so }
  187.      pn[ length( fn ) + 1 ] := fn[ 1 ];  {  transfer from string }
  188.  
  189. END; { make_pathname }
  190.  
  191.  
  192. PROCEDURE Main_Routine;
  193.  
  194. VAR icon_PM : chr2;
  195.     icon_TS : char;
  196.     name_PM : chr16;
  197.     in_path, out_path, in_filename, out_filename : Path_Name;
  198.     icon_name : str16;
  199.     icon : ARRAY [1..53] OF str88;
  200.     good_name, quit : BOOLEAN;
  201.     misc1, misc2 : INTEGER;
  202.     PM_Name_handle , PM_Data_handle , TS_Data_Handle,
  203.     m_error : INTEGER;     
  204.  
  205.  
  206. PROCEDURE Initialize_Variables;
  207.  
  208. BEGIN
  209.      in_filename := '';           { make certain in_filename and }
  210.      in_path := 'A:\*.SDR';       { out_filename are clear of    }
  211.      out_path := 'A:\*.ICN';      { extraneous characters &      }
  212.      out_filename := '';          { set up pathnames.            }
  213.  
  214. END; { iniatialize_variables }
  215.  
  216.  
  217. PROCEDURE Get_PM_Name;
  218.  
  219. VAR start, finish : INTEGER;
  220.  
  221. BEGIN
  222.      IF POS( '.SDR' , in_path ) = 0 THEN    { wrong pathname?         }
  223.      BEGIN
  224.         start := Pos( '.' , in_path );      { strip off extender &    }
  225.         finish := ( length( in_path ) - start ) + 1;  { put on .SDR   }
  226.         delete( in_path, start , finish );
  227.         in_path :=Concat( in_path, '.SDR' );
  228.      END;
  229.      good_name := Get_In_File( in_path, in_filename );
  230.      Clean_Window;
  231.  
  232. END; { get_pm_name }
  233.  
  234.  
  235. PROCEDURE Get_TS_Name;
  236.  
  237. VAR start, finish : INTEGER;
  238.  
  239. BEGIN
  240.      IF POS( '.ICN' , out_path ) = 0 THEN
  241.      BEGIN
  242.         start := Pos( '.' , out_path );      { strip off extender &    }
  243.         finish := ( length( out_path ) - start ) + 1;  { put on .ICN   }
  244.         delete( out_path, start , finish );
  245.         out_path :=Concat( out_path, '.ICN' );
  246.      END;
  247.      good_name := Get_In_File( out_path, out_filename );
  248.  
  249. END; { get_TS_name }
  250.  
  251.  
  252. PROCEDURE Open_PM_File( VAR error : INTEGER );
  253.  
  254. VAR filename : path_chars;
  255.  
  256. BEGIN
  257.       Make_Pathname( filename , in_filename ); 
  258.       error := f_open( filename , 0 );
  259.       PM_Name_handle := error;
  260.  
  261. END; { open_pm_file }
  262.  
  263.  
  264. PROCEDURE Open_PM_Data( VAR error : INTEGER );
  265.  
  266. VAR  start, finish : INTEGER;
  267.      filename : path_chars;
  268.      temp_filename : Path_Name;
  269.  
  270. BEGIN
  271.      temp_filename := in_filename;           { save in_filename        }
  272.      start := Pos( '.' , in_filename );      { strip off extender &    } 
  273.      finish := ( length( in_filename ) - start ) + 1;  { put on .SHP   }
  274.      delete( in_filename, start , finish );
  275.      in_filename :=Concat( in_filename, '.SHP' );
  276.      Make_Pathname( filename , in_filename );
  277.      error := f_open( filename , 0 );
  278.      PM_Data_Handle := error;
  279.      in_filename := temp_filename;           { restore original name   }
  280.  
  281. END; { open_PM_Data }
  282.  
  283.  
  284. PROCEDURE Open_TS_Data( VAR error : INTEGER );
  285.  
  286. VAR filename : path_chars;
  287.  
  288. BEGIN
  289.      Make_Pathname( filename , out_filename );
  290.      error := f_create( filename , 0 );       { error actually the }
  291.      TS_Data_Handle := error;                 { pathnumber         }
  292.  
  293. END; { open_TS_Data }
  294.  
  295.  
  296. PROCEDURE Confirm_Quit;
  297.  
  298. VAR message : str88;
  299.     choice : INTEGER;
  300.  
  301. BEGIN
  302.      message := '[3][ Confirm your | desire to quit. ][ quit | continue ]';
  303.  
  304.      choice := Do_Alert( message, 1 );
  305.  
  306.      IF choice = 1 THEN
  307.           BEGIN 
  308.              quit := TRUE;         { if quit then flags must }
  309.              good_name := TRUE;    { be altered to reflect   }
  310.           END
  311.      ELSE
  312.           quit := FALSE;
  313.  
  314. END; { confirm_quit }
  315.  
  316.  
  317. PROCEDURE Bad_Name( cfile : Path_Name );
  318.  
  319. VAR message : STRING;
  320.     choice  : INTEGER;
  321.  
  322. BEGIN
  323.  
  324.      message := concat( '[1][ ', cfile ) ;
  325.      message := concat( message , '| is invalid. ');
  326.      message := concat( message , '| Do you wish to: ]');
  327.      message := concat( message , '[ quit | retry ]');
  328.  
  329.      choice := Do_Alert( message, 1 );
  330.  
  331.      If choice = 1 THEN            { If quit chosen must change both }
  332.           BEGIN                    { flags so can drop out of two    }
  333.              good_name := TRUE;    { different WHILE loops.          }
  334.              quit := TRUE;
  335.           END
  336.  
  337. END; { bad_name }
  338.  
  339.  
  340. PROCEDURE Check_Name( extender : path_name ; VAR name : path_name;
  341.                       VAR no_error : BOOLEAN );
  342.  
  343. VAR i , j , k : INTEGER;
  344.  
  345. BEGIN
  346.      no_error := TRUE;
  347.      k := 1;                            { make certain filename has }
  348.      i := length( name );               { something in it! & starts }
  349.      j := Pos( '.' , name );                     { with a letter    }
  350.      IF ( i = 0 ) OR ( name[ 1 ] < 'A' ) THEN
  351.        good_name := FALSE                        { otherwise make   }
  352.      ELSE                               { good_name FALSE.          }
  353.         IF j = 0 THEN                   { no extender so add it     }
  354.           BEGIN
  355.               name := CONCAT( name , '.' );        { add period & }
  356.               name := CONCAT( name , extender );   { extender     }
  357.           END
  358.         ELSE                            { has extender so check it }
  359.            FOR i := j + 1 TO j + 3 DO
  360.              BEGIN
  361.                 if name[ i ] <> extender[ k ] THEN   { do extenders match ? }
  362.                   no_error := FALSE;                 { nope!                }
  363.                 k := k + 1;
  364.              END;
  365.      IF no_error = FALSE THEN           { an illegal name found }
  366.           bad_name( name );             { alert & get action    }
  367.  
  368. END; { check_name }
  369.  
  370.  
  371. PROCEDURE Menu;
  372.  
  373. VAR let_x, let_y, pos_x, pos_y : INTEGER;   { for printing icon names   }
  374.     icon_offset, max_icons,                 { icon number & menu offset }
  375.     choice, old_choice : INTEGER;
  376.     names : ARRAY [1..32] OF str16;
  377.     eof, made_choice, done, pop_event : BOOLEAN;
  378.     ch_real : real;
  379.     tempr_str : string;
  380.     tempt_str : string;
  381.  
  382.  
  383. PROCEDURE Print_Menu_Title;
  384.  
  385. VAR info : path_name;
  386.     i : INTEGER;
  387.  
  388. BEGIN
  389.      Clean_Window;
  390.      hide_mouse;
  391.      info := ' ';
  392.      FOR i := 1 to (79 - length( in_filename ) ) DIV 2 DO
  393.         info := concat( info , ' ' );
  394.      info := concat( info , in_filename );
  395.      delete( info , pos( '.' , info ) , 4 );
  396.      Set_WInfo( window_number , info );
  397.      Text_Style( Underlined | Thickened );
  398.      Draw_String( 26 * let_x, 21 * let_y,' Click Left Button To Choose ');
  399.      Text_Style( Normal );
  400.      line_color( black );
  401.      line_style( 1 );           { solid line }
  402.      Frame_Rect( let_x * 31 + 3 , let_y * 4 + 9 ,
  403.                  let_x * 12 + 4 , let_y * 5 - 11 );
  404.      show_mouse;
  405.  
  406. END; { print_menu_title }
  407.  
  408.  
  409. PROCEDURE Get_30_Names( VAR number : INTEGER);
  410.  
  411.      { gets 30 names from file or as many as are left }
  412.  
  413. VAR temp_Char : chr16;
  414.     s_error , r_error : LONG_INTEGER;
  415.     temp_str : str16;
  416.     i : INTEGER;
  417.     found_char : BOOLEAN;
  418.  
  419. BEGIN
  420.      if eof = TRUE THEN            { the last screen found end of file }
  421.           BEGIN                    { so cycle back to first set of     }
  422.                icon_offset := 0;   { names and set flag to FALSE.      }
  423.                eof := FALSE;
  424.           END;
  425.      number := 0;                  { number of names read               }
  426.      s_error := 0;                 { offset in bytes from start of file }
  427.      r_error := 10;                { number of bytes read from file     }
  428.  
  429.      WHILE ( s_error >= 0 ) AND ( number < 30 ) AND
  430.            ( icon_offset + number < 114 )  AND ( r_error <>  0  ) DO
  431.      
  432.      { due to some error I haven't found, can only read the icon data }
  433.      { files for the first 113 icons.  After that get a read error    } 
  434.  
  435.      BEGIN
  436.           s_error := f_Seek( (icon_offset + number) * 16, 
  437.                               PM_Name_handle, 0 );
  438.           r_error := f_read( PM_Name_handle , 16 , temp_char );
  439.           IF ( r_error = 16 ) AND ( s_error >= 0 ) THEN  
  440.                BEGIN                                   { good read so   }
  441.                     temp_str := '                ';    { give temp_str  }
  442.                     FOR i := 1 to 16 DO                { a length and   }
  443.                         temp_str[ i ] := temp_char[ i ];  { move from   }
  444.                                                        { buffer to temp }
  445.  
  446.      { IMPORTANT!! Strings must be read into a CHAR ARRAY and then  }
  447.      { moved over manually into the string. Trying to read a string }
  448.      { directly causes all kinds of grief because 1st char winds up }
  449.      { in 0th cell of string which contains the length of a string! }
  450.  
  451.                     number := number + 1;              { incr number    }
  452.                     names[ number ] := temp_str;       { put into array }
  453.                END { if }
  454.           ELSE
  455.                eof := TRUE;         { if had a read error, set  }
  456.                                     { eof to true.              }
  457.      END; { while }
  458.  
  459.      IF (number = 0) OR                      { last screen or last #  }
  460.         ( icon_offset + number > 113 ) THEN  { was 113 during read.   }
  461.           eof := TRUE;                       { set eof true.          }
  462.  
  463.      names[ number + 1 ] := 'Next Screen     ';   { two prompts added  }
  464.      names[ number + 2 ] := 'Quit            ';   { so they'll print   }
  465.      choice := number + 1;                        { puts cursor on     }
  466.                                                   { next screen choice }
  467. END; { get_30_names }
  468.  
  469.  
  470. PROCEDURE Get_Coordinates( wich : INTEGER );
  471.  
  472. BEGIN
  473.           pos_x := 5;                   { 1st column at 5   }
  474.           pos_y := wich + 5;            { 5 + # of choice   }
  475.                                         { y = ( 6 to 18 )   }
  476.           IF wich > 13 THEN             { chose # > 13 ?    }
  477.                BEGIN                    { if so, start 2nd  }
  478.                     pos_x := 32;        { column at 32      }
  479.                     pos_y := wich - 3;  { choice - 3        }
  480.                END;                     { short column      }
  481.                                         { y = ( 11 - 18 )   } 
  482.           IF wich > 21 THEN             { # chose > 21 ?    }
  483.                BEGIN                    { column 3 at 57    }
  484.                     pos_x := 57;        { y = ( 6 to 16 )   } 
  485.                     pos_y := wich - 16;
  486.                END;
  487.  
  488.           pos_x := pos_x * let_x;      { mult x & y positions to get }
  489.           pos_y := pos_y * let_y;      { dot offsets                 }
  490.  
  491. END; { get_coordinates }
  492.  
  493.  
  494. PROCEDURE Print_30_Names( number : INTEGER );
  495.  
  496. VAR tempr : INTEGER;
  497.     temp_str : str16;
  498.  
  499. BEGIN
  500.      hide_mouse;
  501.      tempr := 1;
  502.      
  503.      FOR tempr := 1 TO number + 2 DO    { number of icon names read }
  504.      BEGIN                              { plus 2 more to print the  }
  505.           Draw_Mode( 1 );               { next screen and quit opts }
  506.           Text_Color( 1 );
  507.           Get_Coordinates( tempr );     { get dot co-ords for drawing }
  508.           Draw_String( pos_x, pos_y, names[ tempr ]);
  509.      END;
  510.      show_mouse;
  511.  
  512. END; { print_30_names }          
  513.  
  514.  
  515. PROCEDURE Get_Choice( VAR choice_made : BOOLEAN );
  516.  
  517. VAR message : MESSAGE_BUFFER;
  518.     which1, dummy, mx, my, button, count : INTEGER;
  519.     Tempr_Str : Str16;
  520.  
  521.  
  522. PROCEDURE Evaluate_Choice;
  523.  
  524. VAR  x, y, temp : INTEGER;
  525.  
  526. BEGIN
  527.      x := ( mx DIV let_x ) ;        { get adjusted x and y co-ords }
  528.      y := ( my DIV let_y ) + 1;
  529.      old_choice := choice;          { save choice }
  530.      choice := 0;
  531.      
  532.      IF ( x > 4 ) AND ( x < 20 ) THEN        { column 1 }
  533.           BEGIN                         
  534.                temp := y - 5;                             { y = 6 - 18 } 
  535.                IF ( temp > 0 ) AND ( temp < 14 ) THEN
  536.                     choice := temp;
  537.           END;
  538.      IF ( x > 31 ) AND ( x < 47 ) THEN       { column 2 }
  539.           BEGIN
  540.                temp := y + 3;                             { y = 11 - 18 }      
  541.                IF ( temp > 13 ) AND ( temp < 22 ) THEN
  542.                     choice := temp;
  543.           END;
  544.      IF ( x > 56 ) AND ( x < 72 ) THEN       { column 3 }
  545.           BEGIN
  546.                temp := y + 16;                            { y = 6 to 16 }
  547.                IF ( temp > 21 ) AND ( temp <= 32 ) THEN
  548.                     choice := temp;
  549.           END;
  550.  
  551.      IF (choice > max_icons + 2 ) OR ( choice < 1 ) THEN  { if choice }
  552.           choice := old_choice;                           { illegal   }
  553.                                                           { reset it  }
  554. END; { evaluate_choice }
  555.  
  556.  
  557. { ============       GET CHOICE STARTS HERE       =============== }
  558.  
  559.  
  560. BEGIN
  561.       button := 0;                        { get rid of old values }
  562.       which1 := 0;                        { which1 & button       }
  563.       which1 := Get_Event( E_Button |
  564.                            E_Timer,       { want buttons or out     }
  565.                          $0001, $0001, 1, { left button, down, &    }
  566.                          350,             { counter for small delay }
  567.                          FALSE, 0,0,0,0,
  568.                          FALSE, 0,0,0,0,
  569.                          message,
  570.                          dummy,         { no key wanted              }
  571.                          count, button, { want count & button state  }
  572.                          mx, my,        { do want coordinates        }
  573.                          dummy );       { no special keys wanted     }
  574.      
  575.       IF pop_event = FALSE THEN                    { throw out choices }
  576.             IF ( button = 1 ) AND ( count = 1 ) THEN { made while busy }
  577.                 choice_made := TRUE                  { clicked ? }
  578.             ELSE
  579.                 BEGIN
  580.                    choice_made := FALSE;     { no, find out x & y }
  581.                    Evaluate_Choice;          { co-ords of mouse   }
  582.                 END
  583.        ELSE
  584.             BEGIN
  585.               choice_made := FALSE;          { next event not ignored }
  586.               pop_event := FALSE;
  587.             END;
  588.  
  589. END; { get_choice }
  590.  
  591.                            
  592. PROCEDURE Highlight_Choice_and_Draw_Icon;
  593.  
  594.  
  595. PROCEDURE Draw_Icon( icon_num : INTEGER );
  596.  
  597. VAR record_num, count, word, byte, state, s_err, r_err : LONG_INTEGER;
  598.     icon_x, icon_y, draw_of_x, draw_of_y, i : INTEGER;
  599.     temp_char : chr16 ;
  600.  
  601. BEGIN
  602.      record_num := ( icon_num - 1 ) * 289 + 2 ; { ignore 1st 2 bytes }
  603.      count := record_num;
  604.                
  605.      draw_of_x := 32 * let_x;      { x & y of icon on screen }
  606.      draw_of_y := 5 * let_y;
  607.      
  608.      icon_y := 1;                  { upper right dot of icon }
  609.      icon_x := 1;
  610.  
  611.      Set_Mouse( M_Bee );
  612.      while record_num < count + 286 DO  { icon is 578 bytes long }
  613.      BEGIN                              { get 2 at time          }
  614.           s_err := f_Seek( record_num * 2 , PM_data_handle , 0 );
  615.           record_num := record_num + 1;
  616.           r_err := f_read( PM_data_handle , 2 , temp_char );
  617.      
  618.           byte := Ord( temp_char[ 1 ] ) * 256 + Ord( temp_char[ 2 ] );
  619.           word := 32768;
  620.      
  621.           For i := 0 TO 15 DO
  622.           BEGIN
  623.                state := word & byte;
  624.                IF state <> 0 THEN
  625.                     BEGIN
  626.                          line_color( black );
  627.                          icon[ icon_y, icon_x ] := '1';
  628.                          line( icon_x + draw_of_x, icon_y + draw_of_y,
  629.                                icon_x + draw_of_x, icon_y + draw_of_y );
  630.                     END
  631.                ELSE
  632.                     BEGIN
  633.                          line_color( white );
  634.                          icon[ icon_y, icon_x ] := '0';
  635.                          line( icon_x + draw_of_x, icon_y + draw_of_y,
  636.                                icon_x + draw_of_x, icon_y + draw_of_y );
  637.                     END;
  638.                icon_x := icon_x + 1;    { icon is 88 by 52 }
  639.                IF icon_x = 89 THEN
  640.                     BEGIN
  641.                          icon_x := 1;
  642.                          icon_y := icon_y +1;
  643.                     END;
  644.                word := word DIV 2;
  645.      
  646.           END; { for }
  647.      END; { while }
  648.      Set_Mouse( M_Arrow );
  649.  
  650. END; { draw_icon }
  651.            
  652.  
  653.      { ======    HIGHLIGHT CHOICE AND DRAW ICON STARTS HERE ======}
  654.  
  655.  
  656. BEGIN
  657.      Hide_Mouse;
  658.      Get_Coordinates( old_choice );
  659.      Text_Color( black );
  660.      Draw_Mode( 1 );          { rewrite in normal }
  661.      If old_choice > 0 THEN
  662.      Draw_String( pos_x, pos_y, names[ old_choice ] );
  663.  
  664.      Get_Coordinates( choice );
  665.      Draw_String( pos_x , pos_y , '                ' );
  666.      Draw_Mode( 4 );          { reverse video new choice }
  667.      Draw_String( pos_x, pos_y, names[ choice ] );
  668.      
  669.      Draw_Mode( 1 );
  670.      Show_Mouse;
  671.      IF ( choice > 0 ) AND ( choice < max_icons + 1 ) THEN
  672.      Draw_Icon( choice + icon_offset );
  673.  
  674. END; { highlight_choice_and_draw_icon }
  675.  
  676.  
  677. PROCEDURE Save_TS_icon;
  678.  
  679. VAR temp_i : INTEGER;
  680.     t_chr : chr2;
  681.     byt, word, err : LONG_INTEGER;
  682.     no_save, open : BOOLEAN;
  683.  
  684.  
  685. PROCEDURE Io_Error_Message;
  686.  
  687. VAR message : str88;
  688.     choice : INTEGER;
  689.  
  690. BEGIN
  691.      good_name := FALSE;
  692.      message := '[3][ I/O error: | Will you: ][ quit | re-try ]';
  693.  
  694.      choice := Do_Alert( message, 1 );
  695.  
  696.      IF choice = 1 THEN
  697.              no_save := TRUE       { drop out of loop }
  698.      ELSE
  699.           no_save := FALSE;        { stay in loop     }
  700.  
  701. END; { io_error_message }
  702.  
  703.  
  704. PROCEDURE Confirm_No_Save;
  705.  
  706. VAR message : str88;
  707.     choice : INTEGER;
  708.  
  709. BEGIN
  710.      message := '[3][ Confirm!:  ][ quit | save ]';
  711.      choice := Do_Alert( message, 2 );
  712.      IF choice = 1 THEN
  713.           BEGIN
  714.              good_name := TRUE;     { allow to fall through good_name }
  715.              no_save   := TRUE;     { name check but not try to save  }
  716.           END;
  717.  
  718. END; { confirm_no_save }
  719.  
  720.  
  721. PROCEDURE Write_Byte;
  722.  
  723. BEGIN
  724.      t_chr[ 1 ] := Chr( byt DIV 256 );       { put high & low bytes }
  725.      t_chr[ 2 ] := Chr( byt MOD 256 );       { in t_char and then   }
  726.      err := f_write( TS_data_handle , 2 , t_chr );
  727.      word := 32768;                          { restore mask and 0   }
  728.      byt := 0;                               { byt for next go      }
  729.  
  730. END; { write_byte }
  731.  
  732.  
  733. PROCEDURE Write_Icon;
  734.  
  735. VAR ix, iy : INTEGER;
  736.  
  737. BEGIN
  738.        Set_Mouse( M_Bee );                        { busy bee while     }
  739.        byt := 0;                                  { writing. 0 byt &   }
  740.        word := 32768;                             { initial the mask   }
  741.        err := 2;                                  { no error at start! }
  742.        iy := 1;
  743.        WHILE ( err = 2 ) AND
  744.              ( iy <= 52 ) DO                      { 52 rows            }
  745.        BEGIN
  746.          ix := 1;
  747.           WHILE ( err = 2 ) AND
  748.                 ( ix <= 88 ) DO                   { get row.  ( 88 )   }
  749.             BEGIN
  750.                 IF icon[ iy, ix ] = '1' THEN      { if dot 1 then      }
  751.                     byt := byt + word;            { add the bit on     }
  752.                 word := SHR( word , 1 );          { shift mask right   }
  753.                 IF word = 0 THEN                  { if mask zero then  }
  754.                     Write_Byte;                   { byte is filled     }
  755.                 ix := ix + 1;
  756.              END;    { ix }                       { write it!          }
  757.                                                   { PM row finished    }
  758.           ix := 12;                               { but TS has more so }
  759.           WHILE ( ix <= 26 ) AND
  760.                 (err = 2 ) DO
  761.                BEGIN                              { tack on zeros to   }
  762.                 Write_Byte;                       { fill. ( when drop  }
  763.                 byt := 0;                         { from x 1 byte left }
  764.                 ix := ix + 1;                     { write it and rest  }
  765.                END;     { ix }                    { write it and rest  }
  766.                                                   { are zeros.         }
  767.           iy := iy + 1;                           { if error occurs    }
  768.        END; { iy }                                { will drop out!!    }
  769.      no_save := TRUE;
  770.      Set_Mouse( M_Arrow );
  771.  
  772. END; { write_icon }
  773.  
  774.      
  775.      { ==============   SAVE TS ICON BEGINS HERE   ================= }
  776.  
  777.  
  778. BEGIN
  779.    no_save := FALSE;                    { outer loop to save icon }
  780.    WHILE no_save = FALSE DO
  781.      BEGIN
  782.        good_name := FALSE;              { just as sounds          }
  783.        open := FALSE;                   { did try open file?      }
  784.  
  785.       WHILE good_name = FALSE DO        { inner loop to get name  }
  786.        BEGIN
  787.            err := 2;                    { no write error in case  }
  788.            Get_TS_Name;                 { decide to drop out      }
  789.               IF good_name = FALSE THEN
  790.                  confirm_no_save        { clicked cancel box      }
  791.               ELSE
  792.                  BEGIN  
  793.                    Check_Name( 'ICN' ,
  794.                                 out_filename ,
  795.                                 good_name );  { is filename good? }
  796.                    no_save := quit;     { quit flag was borrowed  }
  797.                    quit := FALSE;       { so restore now          }
  798.                  END;
  799.        END; { while good_name }
  800.  
  801.      IF no_save = FALSE THEN            { so do save!   }
  802.         BEGIN
  803.           Open_TS_Data( temp_i );       { open file! & set flag }
  804.           open := TRUE;
  805.         END;
  806.      IF ( temp_i >= 0 ) AND
  807.         ( open = TRUE ) THEN            { if open & no error  }
  808.            Write_Icon                   { save icon           }
  809.      ELSE
  810.            If open = TRUE THEN          { do error only if tried open }
  811.               io_error_message;
  812.  
  813.      IF err <>  2 THEN io_error_message;  { error on write }
  814.  
  815.      IF ( open = TRUE ) AND
  816.         ( temp_i >= 0 ) THEN                         { close file      }
  817.         err := f_close( TS_data_handle );            { only if opened! }
  818.  
  819.  END; { while no_save }
  820.  
  821. END; { save_TS_icon }
  822.  
  823.  
  824.      { ==============      MENU BEGINS HERE     ============= }
  825.  
  826.  
  827. BEGIN
  828.      Sys_Font_Size( let_x, let_y, pos_x, pos_y );
  829.      icon_offset := 0;             
  830.      done := FALSE;
  831.      eof := FALSE;
  832.  
  833.      While done = FALSE DO
  834.      BEGIN     
  835.           old_choice := 0;
  836.           Print_menu_title;
  837.           made_choice := FALSE;
  838.           pop_event := TRUE;
  839.           Get_30_Names( max_icons );
  840.           Print_30_Names( max_icons );
  841.           While made_choice = FALSE DO
  842.           BEGIN
  843.  
  844.                Get_Choice( made_choice );
  845.                IF old_choice <> choice THEN
  846.                     highlight_choice_and_draw_icon;
  847.      
  848.           END; { while made_choice }
  849.      
  850.           IF choice = max_icons + 1 THEN          { wants next screen }
  851.                BEGIN
  852.                   made_choice := FALSE;
  853.                   icon_offset := icon_offset + 30;
  854.                   pop_event := TRUE;
  855.                END
  856.           ELSE
  857.                IF choice = max_icons + 2 THEN     { want to quit }
  858.                     done := TRUE
  859.           ELSE
  860.                BEGIN
  861.                     save_TS_icon;                 { save then make sure }
  862.                     done := FALSE;                { repeat loop for in  }
  863.                END;                               { case want more      }
  864.  
  865.      END; { while done }
  866.  
  867. END;  { menu }
  868.  
  869.           
  870.           
  871. {  ===========         Main Routine Begins Here         =========== }
  872.  
  873.  
  874. BEGIN
  875.      Initialize_Variables;
  876.      quit := FALSE;
  877.      While quit = FALSE do
  878.      BEGIN
  879.           good_name := FALSE;
  880.           While good_name = FALSE DO
  881.           BEGIN
  882.                Get_PM_Name;
  883.                IF good_name = FALSE THEN     { CANCEL chosen so        }
  884.                   BEGIN                      { check if want to quit.  }
  885.                     confirm_quit;            { TRUE means yes so cycle }
  886.                   END                        { out of this WHILE loop  }
  887.                ELSE                          { and DO NOT go to the    }
  888.                   check_name( 'SDR' ,
  889.                               in_filename ,
  890.                               good_name );   { MENU procedure.         }
  891.           END; { while }                     { Otherwise, check for    }
  892.                                              { legal filename.         }
  893.  
  894.           IF quit = FALSE THEN
  895.                BEGIN
  896.                   Open_PM_File( misc1 );
  897.                   Open_PM_Data( misc2 );
  898.                   IF (misc1 >= 0) and (misc2 >= 0) THEN   { misc contains the }
  899.                     menu                                  { handles or errors }
  900.                   ELSE
  901.                   m_error := F_Close( PM_Name_handle );
  902.                   m_error := F_Close( PM_data_handle );
  903.                END;
  904.      
  905.      END; { while }
  906.      good_bye;
  907.  
  908. END; { main_routine }
  909.      
  910.  
  911.           { MAIN BUSINESS STARTS HERE }
  912.  
  913.  BEGIN
  914.       IF Init_Gem >=0 THEN
  915.         BEGIN
  916.           Vanity;                            { pre-start messages       }
  917.           Screen_Set_Up( window_number );    { open window and clean it }
  918.           Main_Routine;                      { all the action is here!  }
  919.           Close_Window( window_number );     { all done. Close & delete }
  920.           Delete_Window( window_number );    { window and leave things  }
  921.           Exit_Gem;                          { nice and neat - or else! }
  922.         END;
  923.  END.
  924.